Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue47/IntBase/UnitQueryDB.pas

Pascal/Delphi Source File | 1999-05-03 | 16.3 KB | 496 lines

unit UnitQueryDB;
(*********************************************************

  This unit demonstrates some basic DSQL techniques

  Most, if not all the routines could be defined as
  part of the frs_GDS object, giving us a one stop
  shop for basic database, transaction and DSQL.
  This would make the class a bit more complex and
  we really ought to have separate classes for
  each anyway. However, that leads to more coding -
  we would need to write ways for each class to
  communicate.

  For now, lets just keep things fairly simple and
  demonstrate the techniques.

**********************************************************)

interface

uses SysUtils, frs_Ibase, frs_Ibase_Object, frs_IBStartParams, math;

Type
  TStatementType= ( stUnknown,stSelect,stInsert,stUpdate,stDelete,
                              stDDL,stGetSegment,stPutSegment,stExecProcedure,stStartTrans,
                                  stCommit,stRollback,stSelectForUpdate,stSetGenerator
                  );

  TDsqlExecType = ( dsqlUnknown, dsqlExecImmediate, dsqlExecNoParams, dsqlExecParams,
                     dsqlQueryNoParams, dsqlQueryParams);

Procedure AssignParam(AParam: String; Position: Integer);
Procedure ExecuteStatement;
Procedure PrepareStatement(SQLString: String);
Function ReadRow: String;
Function ReadTitles: String;
Procedure UnprepareStatement;

implementation

function AdjustScale(Value: Integer; Scale: Integer): Double;
//this bit blithely lifted from Greg Deatz' FreeIBComponents.
var
  Scaling, i: Integer;
  Val: Double;
begin
  Scaling := 1;
  Val := Value;
  if Scale > 0 then begin
    for i := 1 to Scale do
      Scaling := Scaling * 10;
    result := Val * Scaling;
    end
  else
    if Scale < 0 then begin
      for i := -1 downto Scale do
        Scaling := Scaling * 10;
      result := Val / Scaling;
      end
    else
      result := Val;
end;

function GetStatementType(StatementHandle: pisc_stmt_handle): TStatementType;
var
  dsql_info  : Char;
  res_buffer : array[0..7] of Char;
  len        : integer;
begin
Result:=stUnknown;
with frs_GDS do begin
  if assigned(StatementHandle) then begin
    fillChar(dsql_info,sizeof(dsql_info),#1);
    fillchar(res_Buffer,SizeOf(res_Buffer),#1);

    dsql_info:=char(isc_info_sql_stmt_type);
    Errorcode:=isc_dsql_sql_info(@StatusVector,@StmtHandle,SizeOf(dsql_info),
                            @dsql_info,SizeOf(res_Buffer),@res_Buffer);

    if (res_buffer[0]=dsql_info) then begin
      len := isc_vax_integer(@res_buffer[1], 2);
      Result:=TStatementType(isc_vax_integer(@res_buffer[3],len));
    end;
  end;
end;

end;

function GetDsqlExecType: TDsqlExecType;
//This will return erroneous data if the statement has not been prepared
//and memory not properly allocated for params and results.

begin
  result:=dsqlUnknown;
with frs_GDS do
  if (inputDataArea^.sqld=0) and (OutputDataArea^.sqld=0) then
    result:=dsqlExecNoParams
  else
    if (inputDataArea^.sqld>0) and (OutputDataArea^.sqld=0) then
      result:=dsqlExecParams
    else
      if (inputDataArea^.sqld=0) and (OutputDataArea^.sqld>0) then
        result:=dsqlQueryNoParams
      else
        if (inputDataArea^.sqld>0) and (OutputDataArea^.sqld>0) then
          result:=dsqlQueryParams;
end;

function Pad(instr: string; len: integer): string;
{pad a string with spaces and return it, or reduce it to len}
begin
result:=instr;
if (length(result)>len) then
  setlength(result,len)
else
  while length(result)<len do
    result:=concat(result,' ');
end;

function LeftPad(instr: string; len: integer): string;
{ Prepend a string with spaces and return it, or reduce it to len
  Typically used to right justify numerics}
begin
result:=instr;
if (length(result)>len) then
  setlength(result,len)
else
  while length(result)<len do
    result:=concat(' ',result);
end;

Procedure AssignParam(AParam: String; Position: Integer);
//This code has been structured to handle almost any datatype
//and has been left intact, even though the example is only
//dealing with a single char.
var
  datatype: SmallInt;
  s: String;
  DateTime : TM;
  DT: TDateTime;
  Yr, Mn, Dy, Hr, Mt, Sc, Ms: Word;
const
  len: integer=0;
begin
  with frs_GDS, InPutDataArea^ do begin
    datatype:= sqlvar[Position].sqltype and (not SQL_NULL);
    case DataType of
      SQL_Short   : begin
                      len:=sqlvar[Position].sqllen;
                      PSmallInt(sqlvar[Position].SQlData)^:=StrToInt(AParam);
                      {$ifdef debug}
                      s:=IntToStr(PSmallInt(sqlvar[Position].SQLData)^)
                      {$endif}
                    end;
      SQL_Long    : begin
                      len:=sqlvar[Position].sqllen;
                      PInteger(sqlvar[Position].SQlData)^:=StrToInt(AParam);
                      {$ifdef debug}
                      s:=IntToStr(PInteger(sqlvar[Position].SQLData)^)
                      {$endif}
                    end;
      SQL_Date    : begin
                      len:=sqlvar[Position].sqllen;
                      s:=AParam;
                      DT:=IBDateStrToDateTime(s);
                      DecodeDate(DT, Yr, Mn, Dy);
                      DecodeTime(DT, Hr, Mt, Sc, Ms);
                      with DateTime do begin
                        sec := Sc;
                        min := Mt;
                        hour := Hr;
                        mday := Dy;
                        mon := Mn - 1;
                        year := Yr - cYearOffset;
                      end;
                      isc_encode_date(@DateTime, PISC_QUAD(sqlvar[Position].sqldata));
                    end;
      SQL_VARYING : begin
                      s:=AParam;
                      len:=length(s);
                      sqlvar[Position].sqltype := SQL_TEXT;
                      fillchar(sqlvar[Position].SQlData^,sqlvar[Position].sqllen,#0);
                      sqlvar[Position].sqllen:=len;
                      move(s[1],sqlvar[Position].SQlData^,len);
                      {$ifdef debug}
                      s:=pchar(sqlvar[Position].SQlData);
                      len:=length(s);
                      {$endif}
                    end;
      SQL_TEXT    : begin
                      s:=AParam;
                      len:=length(s);
                      fillchar(sqlvar[Position].SQlData^,sqlvar[Position].sqllen,#0);
                      sqlvar[Position].sqllen:=len;
                      move(s[1],sqlvar[Position].SQlData^,len);
                      {$ifdef debug}
                      s:=pchar(sqlvar[Position].SQlData);
                      len:=length(s);
                      {$endif}
                    end;

      //Support these datatypes is left as an exercise for the reader
      SQL_FLOAT   : begin
                    ;
                    end;
      SQL_DOUBLE  : begin
                    ;
                    end;

      //These require special processing. Not for the faint hearted
      SQL_BLOB    : begin
                    ;
                    end;
      SQL_ARRAY   : begin
                    ;
                    end;

      //These should not normally be be used, but are theoretically possible.
      SQL_QUAD    : begin
                    ;
                    end;
      SQL_D_FLOAT : begin
                    ;
                    end;
    end;
  end;
end;

Procedure ReadColumn(var AColumn: String; ColNo: Integer);
var
  datatype: SmallInt;
  sqllen: Integer;
  datalen: Integer;
  s: String;
  DateTime : TM;
  pascalDateTime: TDateTime;
begin
with frs_GDS, OutPutDataArea^ do try
  if (sqlvar[ColNo].sqlind^ = -1) then
    AColumn:='(NULL)'
  else begin
    datatype:= sqlvar[ColNo].sqltype and (not SQL_NULL);
    case DataType of
      SQL_FLOAT   : AColumn:=FormatFloat('#,##0.00##',PSingle(sqlvar[ColNo].SQLData)^);
      SQL_DOUBLE  : AColumn:=FormatFloat('#,##0.00##',PDouble(sqlvar[ColNo].SQLData)^);
      SQL_SHORT   : if sqlvar[ColNo].sqlscale=0 then
                      AColumn:=IntToStr(PSmallInt(sqlvar[ColNo].SQLData)^)
                    else
                      AColumn:=FormatFloat('#,##0.00##',AdjustScale(PSmallInt(sqlvar[ColNo].SQLData)^,sqlvar[ColNo].sqlscale));

      SQL_LONG    : if sqlvar[ColNo].sqlscale=0 then
                      AColumn:=IntToStr(PInteger(sqlvar[ColNo].SQLData)^)
                    else
                      AColumn:=FormatFloat('#,##0.00##',AdjustScale(PInteger(sqlvar[ColNo].SQLData)^,sqlvar[ColNo].sqlscale));
      SQL_DATE    : begin
                      isc_Decode_Date(pisc_quad(sqlvar[ColNo].SqlData),@DateTime);
                      PascalDateTime:=EncodeDate(DateTime.year + cYearOffset,DateTime.mon +1,DateTime.mday);
                      PascalDateTime:=PascalDateTime+EnCodeTime(DateTime.hour,DateTime.min,DateTime.Sec,0);
                      AColumn:=FormatDateTime('dd-mmm-yyyy hh:nn:ss',PascalDateTime);
                      end;
      SQL_VARYING : begin
                      datalen:=frs_GDS.isc_vax_integer(sqlvar[ColNo].SQlData,2);
                      s:=pchar(sqlvar[ColNo].SQlData)+2;
                      s:=Copy(S,1,Datalen);
                      AColumn:=s;
                    end;
      SQL_TEXT    : begin
                      sqllen:=sqlvar[ColNo].Sqllen;
                      s:=pchar(sqlvar[ColNo].SQlData);
                      s:=Copy(S,1,Sqllen);
                      AColumn:=s;
                    end;
      SQL_BLOB    : begin
                      If assigned(PISC_QUAD(sqlvar[ColNo].SQlData^)) then
                        AColumn:='(BLOB)'
                      else
                        AColumn:='(Blob)';
                    end;
      SQL_ARRAY   : AColumn:='(Array)';
      SQL_D_FLOAT : AColumn:='(D_Float)';
      SQL_QUAD    : AColumn:='(Quad)';
    else
      AColumn:='(unknown)';
    end;
  end; //else begin

  //now pad to length of title
  datalen:=sqlvar[ColNo].sqllen;
  if sqlvar[ColNo].sqllen>sqlvar[ColNo].aliasname_length then
    AColumn:=pad(AColumn,sqlvar[ColNo].sqllen)
  else
    AColumn:=pad(AColumn,sqlvar[ColNo].aliasname_length);

except
  AColumn:='(Unknown)';
end;


end;

Function ReadTitles: String;
var
  StatementType: TStatementType;
  i: Integer;
  datalen: Integer;
  s: String;
begin
result:='';
with frs_GDS do begin

  StatementType:=GetStatementType(@stmtHandle);

  if (StatementType=stExecProcedure) or (StatementType=stSelect) then
    with OutputDataArea^ do
      for i:=0 to sqln-1 do begin
        s:=copy(string(sqlvar[i].aliasname),1,sqlvar[i].aliasname_length);
        datalen:=sqlvar[i].sqllen;
        if sqlvar[i].sqllen>sqlvar[i].aliasname_length then
          s:=pad(s,sqlvar[i].sqllen)
        else
          s:=pad(s,sqlvar[i].aliasname_length);

        if result='' then
          Result:=s
        else
          Result:=Result+' '+s;

      end;

end; //with frs_GDS
end;


Function ReadRow: String;
var
  StatementType: TStatementType;
  i: Integer;
  datalen: Integer;
  s: String;
begin
result:='';
with frs_GDS do begin

  StatementType:=GetStatementType(@stmtHandle);

  case StatementType of
    stExecProcedure : FetchCode:= 0; //we already have the data in the outputdataarea - dont try to fetch it!!!!
    stSelect        : FetchCode:=isc_dsql_fetch(@StatusVector, @StmtHandle, 1, OutPutDataArea);
  else
    fetchcode:=100;
  end;

  //if row was fetched then process it
  if Fetchcode = 0 then
    with OutputDataArea^ do
      for i:=0 to sqln-1 do begin
        ReadColumn(s,i);
        if result='' then
          Result:=s
        else
          Result:=Result+' '+s;
      end;

  if (StatementType=stExecProcedure) then
    FetchCode:= 100;


end; //with frs_GDS
end;


Procedure ExecuteStatement;
{Executing a statement is not straightforward.
  There are four types of statement.
  Additionally, we have Stored procedures to worry about.

  Beware: Little testing has been done with parameterised stored procedures.

  Warning:
    No coding example is here to deal statement types of stCommit..stRetaining.
    These statements require special care, or rejection, as there are api calls for them.
}
begin
with frs_GDS do
  case GetDsqlExecType of
    dsqlExecNoParams  : if (GetStatementType(@stmtHandle) = stExecProcedure) then
                          //if values are returned they are placed in the OutputDataArea immediately
                          ErrorCode:=isc_dsql_execute2(@StatusVector,@TxnHandle,@stmtHandle,1,nil,OutPutDataArea)
                        else
                          ErrorCode:=isc_dsql_execute(@StatusVector,@TxnHandle,@stmtHandle,1,nil);

    dsqlExecParams    : if (GetStatementType(@stmtHandle) = stExecProcedure) then
                          ErrorCode:=isc_dsql_execute2(@StatusVector,@TxnHandle,@stmtHandle,1,InputDataArea,OutPutDataArea)
                        else
                          ErrorCode:=isc_dsql_execute(@StatusVector,@TxnHandle,@StmtHandle,1,InPutDataArea);

    dsqlQueryNoParams : if (GetStatementType(@stmtHandle) = stExecProcedure) then
                          ErrorCode:=isc_dsql_execute2(@StatusVector,@TxnHandle,@StmtHandle,1,nil,OutPutDataArea)
                        else
                          ErrorCode:=isc_dsql_execute(@StatusVector,@TxnHandle,@StmtHandle,1,nil);

    dsqlQueryParams   : if (GetStatementType(@stmtHandle) = stExecProcedure) then
                          ErrorCode:=isc_dsql_execute2(@StatusVector,@TxnHandle,@StmtHandle,1,nil,OutPutDataArea)
                        else
                          ErrorCode:=isc_dsql_execute(@StatusVector,@TxnHandle,@StmtHandle,1,InputDataArea);

  end;

end;

Procedure PrepareStatement(SQLString: String);
{ This is a generic routine that does more than always necessary.

We do several things here
  1/ Allocate Statement Handle
  2/ Prepare it
  3/ Find out about parameters to it
  4/ Allocate memory for the parameters.
  5/ Find out about the columns in the result set
  6/ Allocate memory to store each column in the result set

  If your statement doesn't use params or return a result set then
  some parts may be skipped.
}
var
  i: Integer;
begin
with frs_GDS do begin

  //In real world, we might want to reconsider if the XSQLDAs are not NIL to start with.
  if not assigned(InputDataArea) then
    InitSQLDA(InputDataArea,1);

  if not assigned(OutputDataArea) then
    InitSQLDA(OutputDataArea,1);

  //get a statement handle
  //(In real world, we should check that the StmtHandle is NIL - if not nil, then why? Is it active?)
  Errorcode:=isc_dsql_allocate_statement(@StatusVector,@DBHandle,@StmtHandle);

  Errorcode:=isc_dsql_prepare(@StatusVector,@TxnHandle,@StmtHandle,0,PChar(SQLString),1,OutputDataArea);

  {Here we will go through the motions of setting up for a parameterized query.
  More sophisticated code could check ahead and remove these calls if unnecessary.}

  //call describe_bind to find out how many params there are
  ErrorCode:=isc_dsql_describe_bind(@StatusVector,@StmtHandle,1,InputDataArea);

  //read the number of params in the statement
  i:=InPutDataArea^.sqld;

  //now allocate space for that many params
  InitSQLDA(InPutDataArea,i);
  ErrorCode:=isc_dsql_describe_bind(@StatusVector,@StmtHandle,1,InputDataArea);

  //allocate memory for the params
  AllocateSQLData(InPutDataArea);

  //Now look at the results - again we could check ahead and skip this if not a select statement

  //find out how many columns in the result set
  i:=OutPutDataArea^.sqld;

  //re-initialize XSQLDA for these columns
  InitSQLDA(OutPutDataArea,i);

  //prepare has already laid the groundwork so we only need to call describe once
  ErrorCode:=isc_dsql_describe(@StatusVector,@StmtHandle,1,OutPutDataArea);

  //now allocate the memory to hold the result
  AllocateSQLData(OutPutDataArea);

end;

end;

Procedure UnprepareStatement;
begin

  with frs_GDS do begin
    if assigned(StmtHandle) then begin
      ErrorCode:=isc_dsql_free_statement(@StatusVector, @StmtHandle, DSQL_Drop);
      StmtHandle:=nil;
    end;

    FreeSQLData(InputDataArea);
    FreeSQLData(OutputDataArea);

  end;

end;


end.